home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Software Vault: The Gold Collection
/
Software Vault - The Gold Collection (American Databankers) (1993).ISO
/
cdr52
/
tbar.zip
/
FTDIR.PRG
< prev
next >
Wrap
Text File
|
1993-04-01
|
7KB
|
152 lines
/*┌──────────────────────────────────────────────────────────────────────┐
▌│ Program Name: FTDIR.PRG Language: Clipper 5.0 │
▌│ Date Created: Author: Kevin S Gallagher │
▌│ Show a single highlight bar in a TBrowse, uses NANFOR.LIB │
▌└──────────────────────────────────────────────────────────────────────┘
▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀ */
#include 'include1.ch'
function main
local nVal:= FT_DIR2DB( "*.*","testksg","ksgntx" )
local oldc:= setcursor( 0 )
set(_SET_SCOREBOARD, .f.)
if nVal = 0
TBView()
ferase("testksg.dbf") // cleanup
ferase("ksgntx.ntx") // unwanted files
endif
setcursor( oldc )
return nil
/*
╔════════════════════════════════════════════════════════════════════════════╗
║ This function uses TBrowse to view a database that was created with ║
║ FT_DIR2DB() -- (See NANFORUM's NG HelpDatabase) ║
║ ║
║ When TBrowse shows data (.dbf, textfiles, arrays etc.), the current cell ║
║ is highlighted with a specified color from "colorSpec" or SETCOLOR() ║
║ Providing "autoLite" is set to logical "true". By using "colorRect()" ║
║ method a rectangular area may be painted, thus allowing all the cells on ║
║ the current TBrowse row to be highlighted, instead of just one cell. ║
║ Note that "colorRect" does not paint the column separator character! ║
║ One way of painting the separator character is to use a function that ║
║ will change the color attributes of a screen region. Since the library ║
║ "Nanfor.lib" is Public Domain, and it has just the function needed to get ║
║ the job done "FT_SETATTR()" which is written in assemble language, so its ║
║ fast! ║
║ ║
║ FT_SETATTR( <nTopRow>, <nTopCol>, <nBotRow>, <nBotCol>, nColor ) ║
║ FT_SETATTR( b:rowPos+4, oTc, b:rowPos+4, oBc-1, 95 ) ║
║ <nTopRow> is TBrowse's TopRow --> 1 When TBrowse is first shown.. ║
║ So that in this example, if we simple pass "b:rowPos" to FT_SETATTR() ║
║ the highlight would end up above the TBrowse, and the surrounding box. ║
║ Being that FT_SETATTR() uses screen coordinates, not TBrowse coordinates. ║
║ So I added the amount of rows, above the TBrowse to get the correct ║
║ Browse row, and the same goes for <nBotRow> since it must be informed ║
║ that we want the highlight to be the same as <nTopRow>. ║
║ ║
║ Ignore <nBotCol> "oBc-1" the "-1" has nothing to do with our highlight ║
║ bar, it is for fixing a small problem, in BoxShad(). I wanted to keep ║
║ the screen code out of sight.. ║
╚════════════════════════════════════════════════════════════════════════════╝
*/
function TBView
local oTr:=3,oTc:=4,oBr:=20,oBc:=72,key:= 0, b,c
local SaveFullScreen()
Panel(.F.)
BoxShad(oTr,oTc,oBr,oBc,"W/B")
USE testksg NEW
IF !NETERR()
DBSETINDEX("ksgntx")
ELSE
alert("Network error")
quit
ENDIF
// @ oTr-3,oTc+2 say " TBrowse row "
b:=TBrowseDB(oTr, oTc, oBr-1, oBc-1)
b:colorSpec := BCOLOR //── include1.ch
b:headSep := '═╤═'
b:colSep := ' │ '
c:=TBColumnNew('Name', fieldblock('NAME'))
c:width := 12
b:AddColumn( c )
c := TBColumnNew('Size', fieldblock('SIZE'))
b:AddColumn( c )
c := TBColumnNew('Date', fieldblock('DATE'))
b:AddColumn( c )
c:=TBColumnNew('Time',{||FT_MIL2CIV(STRTRAN(SUBSTR(testksg->TIME,1,5),;
":","";
);
);
};
)
b:AddColumn( c )
c := TBColumnNew('Attribute', fieldblock('ATTR'))
b:AddColumn( c )
BEGIN SEQUENCE
DO WHILE .T.
*
* Paint the top row of the browse with all cells highlighted
b:colorRect( { b:rowPos, 1, b:rowPos, b:colCount } , { 1 , 1 } )
STABILIZE b //── see include1.ch
do while .not. b:stabilize() ; enddo
if b:stabilize()
@ oTr-1,oTc+2 say padr("["+str(b:rowPos,2,0)+"]",4)
*
* Paint all cells on current row
* paint column separator character, using ft_setattr()
*
b:colorRect( { b:rowPos, 1, b:rowPos, b:colCount } , { 2 , 2 } )
FT_SETATTR( b:rowPos+4, oTc, b:rowPos+4, oBc-1, 95 )
while ((key := inkey(.1)) == 0)
*
* Show a message
*
RainHead()
enddo
endif
do case
case key == K_ESC ; alert("Press F10 to exit")
case key == K_F1 ; alert("NO HELP")
case key == K_UP ; b:up()
case key == K_DOWN ; b:down()
case key == K_PGDN ; b:pageDown()
case key == K_PGUP ; b:pageUp()
case key == K_CTRL_PGDN ; b:goBottom()
case key == K_CTRL_PGUP ; b:goTop()
case key == K_HOME ; b:home()
case key == K_F10 ; break
case key == K_END ; b:end()
endcase
enddo
END SEQUENCE
RestFullScreen()
dbCloseArea()
return nil
static function RainHead() //── Michael J. Riche
local TBTline := " Check out the TBrowse highlight-bar "
local XLEN := LEN(TBTline)
local nLen := XLEN - 1
local C := ( (80-XLEN) / 2 )
local R := 0
static Colors := {'G+','BG','R+','B','G+','RB','R+','BG+','R','B+','G','RB+'}
static w := 0
static nCnt := 0
SetPos(R,C ) ; ;
DispOut( TBTline, "W+/BG")
SetPos(R,C + nCnt ) ; ;
DispOut( substr(TBTline, nCnt + 1, 1) , colors[++w % 12 + 1] + '/N')
IF w > 11
w := 0
ENDIF
IF (++nCnt > nLen)
nCnt := 0
ENDIF
return (nil)